(use-modules (gnu packages)
             (guix packages)
             (ice-9 match)
             (srfi srfi-1)
             (srfi srfi-26))

;;; Find which packages propagate a specific package
(define* (package->inputs package #:key transitive?
                          (types '(native normal propagated)))
  "Find the inputs of PACKAGE.  Types is a list that can contain one
or more of the 'native, 'normal or 'propagated symbols.  Origin
objects are removed from the results."

  (define-syntax-rule (and/null expr ...)
    "Like and, but returns '() upon encountering #f."
    (or (and expr ...)
        '()))

  (define* (package->inputs* package)
    "Return a procedure that returns the inputs TYPES of PACKAGE."
    (append-map (lambda (proc)
                  (proc package))
                (if transitive?
                    `(,@(and/null (member 'normal types)
                                  (list package-transitive-inputs))
                      ,@(and/null (member 'native types)
                                  (list package-transitive-native-inputs))
                      ,@(and/null (member 'propagated types)
                                  (list package-transitive-propagated-inputs)))
                    `(,@(and/null (member 'normal types)
                                  (list package-inputs))
                      ,@(and/null (member 'native types)
                                  (list package-native-inputs))
                      ,@(and/null (member 'propagated types)
                                  (list package-propagated-inputs))))))

  (filter package?                      ;eliminate origin objects
          (map (match-lambda
                 ((name package output ...)
                  package))
               (delete-duplicates (remove null? (package->inputs* package))))))

(define* (has-input? package input #:key (transitive? #t)
                     (types '(native normal propagated)))
  "True if PACKAGE has INPUT among its inputs.  By default, all types
of packages are considered transitively, but this can be adjusted via
the TRANSITIVE? and TYPES parameters."
  (member input (package->inputs package #:transitive? transitive?
                                 #:types types)))

(define (run-example)
  ;; Find all the packages propagating gdk-pixbuf.
  (let ((gdk-pixbuf (specification->package "gdk-pixbuf")))
    (fold-packages (lambda (package result)
                     (if (has-input? package gdk-pixbuf
                                     #:transitive? #f
                                     #:types '(propagated))
                         (cons package result)
                         result))
                   '())))
